home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Use_of_DWM2084049202007.psc / dwm glas / DWM_Label.ctl next >
Text File  |  2007-09-20  |  15KB  |  464 lines
  1. VERSION 5.00
  2. Begin VB.UserControl DWM_Label 
  3.    BackColor       =   &H00000000&
  4.    ClientHeight    =   645
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   3855
  8.    ClipControls    =   0   'False
  9.    EditAtDesignTime=   -1  'True
  10.    BeginProperty Font 
  11.       Name            =   "Tahoma"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   400
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    HitBehavior     =   2  'Use Paint
  20.    ScaleHeight     =   43
  21.    ScaleMode       =   3  'Pixel
  22.    ScaleWidth      =   257
  23.    Begin VB.Timer Tm_Blend 
  24.       Enabled         =   0   'False
  25.       Interval        =   1
  26.       Left            =   3360
  27.       Top             =   120
  28.    End
  29. End
  30. Attribute VB_Name = "DWM_Label"
  31. Attribute VB_GlobalNameSpace = False
  32. Attribute VB_Creatable = True
  33. Attribute VB_PredeclaredId = False
  34. Attribute VB_Exposed = False
  35. Option Explicit
  36.  
  37. ' Events and User-defined Types and variables ###################################
  38. '#####################################################################
  39.  
  40. Event Click()
  41. Event DblClick()
  42. Event MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  43. Event MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  44. Event MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
  45. Event MouseLeave()
  46. Event MouseEnter()
  47.  
  48. Private FA_DWM_Label_Prop_Enabled As Boolean
  49. Private FA_DWM_Label_Prop_Caption As String
  50. Private FA_DWM_Label_Prop_ForeColor As OLE_COLOR
  51. Private FA_DWM_Label_Prop_BackColor As OLE_COLOR
  52. Private FA_DWM_Label_Prop_GlowColor As OLE_COLOR
  53. Private FA_DWM_Label_Prop_HoverColor As OLE_COLOR
  54. Private FA_DWM_Label_Prop_UseHover As Boolean
  55. Private FA_DWM_Label_Prop_GlowSize As Single
  56. Private FA_DWM_Label_Prop_AutoSize As Boolean
  57. Private FA_DWM_Label_Prop_UseBlend As Boolean
  58. Private FA_DWM_Label_Prop_FadeInStep As Single
  59. Private FA_DWM_Label_Prop_FadeOutStep As Single
  60.  
  61. Private FA_DWM_Label_ThemeTextObj As FA_Type_DWM_ThemeText
  62. Private FA_DWM_Label_IsReady As Boolean
  63. Private FA_DWM_Label_IsMouseIn As Boolean
  64. Private FA_DWM_Label_BlendDone As Long
  65. Private FA_DWM_Label_IsSubClas As Boolean
  66.  
  67. Private Sub Tm_Blend_Timer()
  68.  
  69. DoEvents
  70.  
  71. FA_DWM_Label_BlendDone = FA_DWM_Label_BlendDone + IIf(FA_DWM_Label_IsMouseIn, FA_DWM_Label_Prop_FadeInStep, FA_DWM_Label_Prop_FadeOutStep)
  72.  
  73. If (FA_DWM_Label_BlendDone >= 255) Then
  74.     Tm_Blend.Enabled = False
  75.     FA_DWM_Label_BlendDone = 255
  76. End If
  77.  
  78. FA_DWM_Label_RebuildUI
  79.  
  80. End Sub
  81.  
  82. Private Sub Usercontrol_Click()
  83. RaiseEvent Click
  84. End Sub
  85.  
  86. Private Sub Usercontrol_DblClick()
  87. RaiseEvent DblClick
  88. End Sub
  89.  
  90. Private Sub UserControl_Initialize()
  91.  
  92. FA_DWM_Label_IsSubClas = False
  93. FA_DWM_Label_IsReady = False
  94. Enabled = True
  95. Caption = "Theme Label"
  96. ForeColor = vbBlack
  97. BackColor = vbBlack
  98. GlowColor = vbWhite
  99. HoverColor = &H764521
  100. UseHover = False
  101. FadeInStep = 25
  102. FadeOutStep = 10
  103. GlowSize = 10
  104. Font = UserControl.Font
  105. AutoSize = True
  106.  
  107. FA_DWM_Label_IsReady = True
  108. FA_DWM_Label_BlendDone = 255
  109.  
  110. FA_DWM_Label_RebuildUI
  111.  
  112. End Sub
  113.  
  114. Private Sub Usercontrol_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
  115. RaiseEvent MouseDown(Button, Shift, x, Y)
  116. End Sub
  117.  
  118. Private Sub Usercontrol_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
  119. FA_DWM_Label_Handler_WM_MOUSEHOVER
  120. RaiseEvent MouseMove(Button, Shift, x, Y)
  121. End Sub
  122.  
  123. Private Sub Usercontrol_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
  124. RaiseEvent MouseUp(Button, Shift, x, Y)
  125. End Sub
  126.  
  127. Private Sub UserControl_Paint()
  128. FA_DWM_Label_RebuildUI
  129. End Sub
  130.  
  131. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  132. FA_DWM_Label_Prop_Enabled = PropBag.ReadProperty("Enabled", True)
  133. FA_DWM_Label_Prop_Caption = PropBag.ReadProperty("Caption", "Theme Label")
  134. FA_DWM_Label_Prop_ForeColor = PropBag.ReadProperty("ForeColor", vbBlack)
  135. FA_DWM_Label_Prop_BackColor = PropBag.ReadProperty("BackColor ", vbBlack)
  136. FA_DWM_Label_Prop_GlowColor = PropBag.ReadProperty("GlowColor", vbWhite)
  137. FA_DWM_Label_Prop_HoverColor = PropBag.ReadProperty("HoverColor", &H764521)
  138. FA_DWM_Label_Prop_UseHover = PropBag.ReadProperty("UseHover", False)
  139. FA_DWM_Label_Prop_GlowSize = PropBag.ReadProperty("GlowSize", 10)
  140. FA_DWM_Label_Prop_FadeInStep = PropBag.ReadProperty("FadeInStep", 25)
  141. FA_DWM_Label_Prop_FadeOutStep = PropBag.ReadProperty("FadeOutStep", 10)
  142. FA_DWM_Label_Prop_UseBlend = PropBag.ReadProperty("UseBlend", True)
  143. Set UserControl.Font = PropBag.ReadProperty("Font", "Tahoma")
  144. FA_DWM_Label_Prop_AutoSize = PropBag.ReadProperty("AutoSize", True)
  145. End Sub
  146.  
  147. Private Sub UserControl_Resize()
  148.  
  149. FA_DWM_Label_RebuildUI
  150.  
  151. End Sub
  152.  
  153. Private Sub UserControl_Show()
  154.  
  155. FA_DWM_Label_IsReady = False
  156. Enabled = FA_DWM_Label_Prop_Enabled
  157. Caption = FA_DWM_Label_Prop_Caption
  158. ForeColor = FA_DWM_Label_Prop_ForeColor
  159. BackColor = FA_DWM_Label_Prop_BackColor
  160. GlowColor = FA_DWM_Label_Prop_GlowColor
  161. HoverColor = FA_DWM_Label_Prop_HoverColor
  162. UseHover = FA_DWM_Label_Prop_UseHover
  163. GlowSize = FA_DWM_Label_Prop_GlowSize
  164. UseBlend = FA_DWM_Label_Prop_UseBlend
  165. FadeInStep = FA_DWM_Label_Prop_FadeInStep
  166. FadeOutStep = FA_DWM_Label_Prop_FadeOutStep
  167. Font = UserControl.Font
  168. FA_DWM_Label_IsReady = True
  169.  
  170. FA_DWM_Label_RebuildUI
  171.  
  172. End Sub
  173.  
  174. Private Sub UserControl_Terminate()
  175. FA_DWM_Label_FreeDC_Src
  176. FA_DWM_Label_FreeDC_Dest
  177. FA_DWM_Label_SubClas_End
  178. End Sub
  179.  
  180. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  181. Call PropBag.WriteProperty("Enabled", FA_DWM_Label_Prop_Enabled, True)
  182. Call PropBag.WriteProperty("Caption", FA_DWM_Label_Prop_Caption, "Theme Label")
  183. Call PropBag.WriteProperty("ForeColor", FA_DWM_Label_Prop_ForeColor, vbBlack)
  184. Call PropBag.WriteProperty("BackColor", FA_DWM_Label_Prop_BackColor, vbBlack)
  185. Call PropBag.WriteProperty("GlowColor", FA_DWM_Label_Prop_GlowColor, vbWhite)
  186. Call PropBag.WriteProperty("HoverColor", FA_DWM_Label_Prop_HoverColor, &H764521)
  187. Call PropBag.WriteProperty("UseHover", FA_DWM_Label_Prop_UseHover, False)
  188. Call PropBag.WriteProperty("GlowSize", FA_DWM_Label_Prop_GlowSize, 10)
  189. Call PropBag.WriteProperty("UseBlend", FA_DWM_Label_Prop_UseBlend, True)
  190. Call PropBag.WriteProperty("FadeInStep", FA_DWM_Label_Prop_FadeInStep, 25)
  191. Call PropBag.WriteProperty("FadeOutStep", FA_DWM_Label_Prop_FadeOutStep, 10)
  192. Call PropBag.WriteProperty("Font", UserControl.Font, "Tahoma")
  193. Call PropBag.WriteProperty("AutoSize", FA_DWM_Label_Prop_AutoSize, True)
  194. End Sub
  195.  
  196. Private Sub FA_DWM_Label_RebuildUI()
  197.  
  198. If Not FA_DWM_Label_IsReady Then Exit Sub
  199.  
  200. Tm_Blend.Enabled = False
  201. If Not FA_DWM_Label_Prop_UseBlend Then FA_DWM_Label_BlendDone = 255
  202.  
  203. FA_DWM_Label_ThemeTextObj.Caption = Caption
  204. Set FA_DWM_Label_ThemeTextObj.Font = UserControl.Font
  205. FA_DWM_Label_ThemeTextObj.GlowSize = GlowSize
  206. FA_DWM_Label_ThemeTextObj.hWnd = UserControl.hWnd
  207. FA_DWM_Label_ThemeTextObj.IsCustomDC = False
  208. FA_DWM_Label_ThemeTextObj.Width = UserControl.TextWidth(Caption) + (FA_DWM_Label_ThemeTextObj.GlowSize * 2)
  209. FA_DWM_Label_ThemeTextObj.Height = UserControl.TextHeight(Caption) + (FA_DWM_Label_ThemeTextObj.GlowSize * 2)
  210. If AutoSize Then
  211.         UserControl.Width = FA_DWM_Label_ThemeTextObj.Width * Screen.TwipsPerPixelX
  212.         UserControl.Height = FA_DWM_Label_ThemeTextObj.Height * Screen.TwipsPerPixelY
  213. End If
  214. FA_DWM_Label_ThemeTextObj.Left = 0
  215. FA_DWM_Label_ThemeTextObj.Top = (UserControl.ScaleHeight / 2) - (FA_DWM_Label_ThemeTextObj.Height / 2)
  216.  
  217. FA_DWM_Label_FreeDC_Dest
  218. FA_DWM_Label_FreeDC_Src
  219.  
  220. Dim ARGBStruct_ForeColor  As FA_Type_ARGB
  221. Dim ARGBStruct_HoverColor  As FA_Type_ARGB
  222. Dim R As Single
  223. Dim G As Single
  224. Dim B As Single
  225.  
  226. GetARGBVal ForeColor, ARGBStruct_ForeColor
  227. GetARGBVal HoverColor, ARGBStruct_HoverColor
  228.  
  229. R = ((IIf(FA_DWM_Label_IsMouseIn, 255 - FA_DWM_Label_BlendDone, FA_DWM_Label_BlendDone) / 255) * (ARGBStruct_ForeColor.Red - ARGBStruct_HoverColor.Red)) + ARGBStruct_HoverColor.Red
  230. G = ((IIf(FA_DWM_Label_IsMouseIn, 255 - FA_DWM_Label_BlendDone, FA_DWM_Label_BlendDone) / 255) * (ARGBStruct_ForeColor.Green - ARGBStruct_HoverColor.Green)) + ARGBStruct_HoverColor.Green
  231. B = ((IIf(FA_DWM_Label_IsMouseIn, 255 - FA_DWM_Label_BlendDone, FA_DWM_Label_BlendDone) / 255) * (ARGBStruct_ForeColor.Blue - ARGBStruct_HoverColor.Blue)) + ARGBStruct_HoverColor.Blue
  232.  
  233. FA_DWM_Label_ThemeTextObj.ForeColor = RGB(R, G, B)
  234. FA_ThemeText_Draw FA_DWM_Label_ThemeTextObj
  235.  
  236. If FA_DWM_Label_BlendDone < 255 Then Tm_Blend.Enabled = True
  237.  
  238. End Sub
  239.  
  240. Public Sub Refresh()
  241. If Not FA_DWM_Label_IsReady Then Exit Sub
  242. FA_ThemeText_Refresh FA_DWM_Label_ThemeTextObj
  243. End Sub
  244.  
  245. Public Property Let Enabled(ByVal Value As Boolean)
  246. UserControl.Enabled = Value
  247. FA_DWM_Label_Prop_Enabled = Value
  248. PropertyChanged "Enabled"
  249. End Property
  250.  
  251. Public Property Get Enabled() As Boolean
  252. Enabled = FA_DWM_Label_Prop_Enabled
  253. End Property
  254.  
  255. Public Property Let UseHover(ByVal Value As Boolean)
  256. If Not Value Then UseBlend = False
  257. FA_DWM_Label_Prop_UseHover = Value
  258. PropertyChanged "UseHover"
  259. FA_DWM_Label_RebuildUI
  260. End Property
  261.  
  262. Public Property Get UseHover() As Boolean
  263. UseHover = FA_DWM_Label_Prop_UseHover
  264. End Property
  265.  
  266. Public Property Let UseBlend(ByVal Value As Boolean)
  267. If Value Then UseHover = True
  268. FA_DWM_Label_Prop_UseBlend = Value
  269. PropertyChanged "UseBlend"
  270. End Property
  271.  
  272. Public Property Get UseBlend() As Boolean
  273. UseBlend = FA_DWM_Label_Prop_UseBlend
  274. End Property
  275.  
  276. Public Property Let FadeInStep(ByVal Value As Integer)
  277. FA_DWM_Label_Prop_FadeInStep = Value
  278. PropertyChanged "FadeInStep"
  279. End Property
  280.  
  281. Public Property Get FadeInStep() As Integer
  282. FadeInStep = FA_DWM_Label_Prop_FadeInStep
  283. End Property
  284.  
  285. Public Property Let FadeOutStep(ByVal Value As Integer)
  286. FA_DWM_Label_Prop_FadeOutStep = Value
  287. PropertyChanged "FadeOutStep"
  288. End Property
  289.  
  290. Public Property Get FadeOutStep() As Integer
  291. FadeOutStep = FA_DWM_Label_Prop_FadeOutStep
  292. End Property
  293.  
  294. Public Property Let AutoSize(ByVal Value As Boolean)
  295. If FA_DWM_Label_Prop_AutoSize = Value Then Exit Property
  296. FA_DWM_Label_Prop_AutoSize = Value
  297. PropertyChanged "AutoSize"
  298. FA_DWM_Label_RebuildUI
  299. End Property
  300.  
  301. Public Property Get AutoSize() As Boolean
  302. AutoSize = FA_DWM_Label_Prop_AutoSize
  303. End Property
  304.  
  305. Public Property Let Caption(ByVal Value As String)
  306. If FA_DWM_Label_Prop_Caption = Value Then Exit Property
  307. FA_DWM_Label_Prop_Caption = Value
  308. PropertyChanged "Caption"
  309. FA_DWM_Label_RebuildUI
  310. End Property
  311.  
  312. Public Property Get Caption() As String
  313. Caption = FA_DWM_Label_Prop_Caption
  314. End Property
  315.  
  316. Public Property Let Font(Value As StdFont)
  317. If UserControl.Font = Value Then Exit Property
  318. Set UserControl.Font = Value
  319. PropertyChanged "Font"
  320. FA_DWM_Label_RebuildUI
  321. End Property
  322.  
  323. Public Property Get Font() As StdFont
  324. Set Font = UserControl.Font
  325. End Property
  326.  
  327. Public Property Let ForeColor(ByVal Value As OLE_COLOR)
  328. If FA_DWM_Label_Prop_ForeColor = Value Then Exit Property
  329. FA_DWM_Label_Prop_ForeColor = Value
  330. PropertyChanged "ForeColor"
  331. FA_DWM_Label_RebuildUI
  332. End Property
  333.  
  334. Public Property Get ForeColor() As OLE_COLOR
  335. ForeColor = FA_DWM_Label_Prop_ForeColor
  336. End Property
  337.  
  338. Public Property Let BackColor(ByVal Value As OLE_COLOR)
  339. If FA_DWM_Label_Prop_BackColor = Value Then Exit Property
  340. FA_DWM_Label_Prop_BackColor = Value
  341. UserControl.BackColor = Value
  342. PropertyChanged "BackColor"
  343. Refresh
  344. End Property
  345.  
  346. Public Property Get BackColor() As OLE_COLOR
  347. BackColor = FA_DWM_Label_Prop_BackColor
  348. End Property
  349.  
  350. Public Property Let GlowColor(ByVal Value As OLE_COLOR)
  351. If FA_DWM_Label_Prop_GlowColor = Value Then Exit Property
  352. FA_DWM_Label_Prop_GlowColor = Value
  353. PropertyChanged "GlowColor"
  354. FA_DWM_Label_RebuildUI
  355. End Property
  356.  
  357. Public Property Get GlowColor() As OLE_COLOR
  358. GlowColor = FA_DWM_Label_Prop_GlowColor
  359. End Property
  360.  
  361. Public Property Let HoverColor(ByVal Value As OLE_COLOR)
  362. If FA_DWM_Label_Prop_HoverColor = Value Then Exit Property
  363. FA_DWM_Label_Prop_HoverColor = Value
  364. PropertyChanged "HoverColor"
  365. FA_DWM_Label_RebuildUI
  366. End Property
  367.  
  368. Public Property Get HoverColor() As OLE_COLOR
  369. HoverColor = FA_DWM_Label_Prop_HoverColor
  370. End Property
  371.  
  372. Public Property Let GlowSize(ByVal Value As Integer)
  373. If FA_DWM_Label_Prop_GlowSize = Value Then Exit Property
  374. FA_DWM_Label_Prop_GlowSize = Value
  375. PropertyChanged "GlowSize"
  376. FA_DWM_Label_RebuildUI
  377. End Property
  378.  
  379. Public Property Get GlowSize() As Integer
  380. GlowSize = FA_DWM_Label_Prop_GlowSize
  381. End Property
  382.  
  383. Private Function FA_DWM_Label_SubClas_Start()
  384.  
  385. If FA_DWM_Label_IsSubClas Then Exit Function
  386. SetProp UserControl.hWnd, "FA_ExWndProcPtr", GetWindowLong(UserControl.hWnd, GWL_WNDPROC)
  387. SetWindowLong UserControl.hWnd, GWL_WNDPROC, AddressOf FA_SubClas_WndProc
  388. SetWindowLong UserControl.hWnd, GWL_USERDATA, ObjPtr(Me)
  389. FA_DWM_Label_IsSubClas = True
  390.  
  391. End Function
  392.  
  393. Private Function FA_DWM_Label_SubClas_End()
  394.  
  395. If Not FA_DWM_Label_IsSubClas Then Exit Function
  396. SetWindowLong UserControl.hWnd, GWL_WNDPROC, GetProp(UserControl.hWnd, "FA_ExWndProcPtr")
  397. RemoveProp UserControl.hWnd, "FA_ExWndProcPtr"
  398. FA_DWM_Label_IsSubClas = False
  399.  
  400. End Function
  401.  
  402. Private Function FA_DWM_Label_Handler_WM_MOUSELEAVE()
  403.  
  404. If Not FA_DWM_Label_IsMouseIn Then Exit Function
  405. FA_DWM_Label_IsMouseIn = False
  406. FA_DWM_Label_BlendDone = 255 - FA_DWM_Label_BlendDone
  407. FA_DWM_Label_RebuildUI
  408. FA_DWM_Label_SubClas_End
  409. RaiseEvent MouseLeave
  410.  
  411. End Function
  412.  
  413. Private Function FA_DWM_Label_Handler_WM_MOUSEHOVER()
  414.  
  415. If FA_DWM_Label_IsMouseIn Then Exit Function
  416. If Not Enabled Then Exit Function
  417. FA_DWM_Label_IsMouseIn = True
  418. FA_DWM_Label_TrackMouse_Start
  419. FA_DWM_Label_BlendDone = 255 - FA_DWM_Label_BlendDone
  420. FA_DWM_Label_RebuildUI
  421. FA_DWM_Label_SubClas_Start
  422. RaiseEvent MouseEnter
  423.  
  424. End Function
  425.  
  426. Public Function FA_Handler_WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal WParam As Long, ByVal LParam As Long) As Long
  427.  
  428. If uMsg = WM_MOUSELEAVE Then
  429.         FA_DWM_Label_Handler_WM_MOUSELEAVE
  430.         FA_Handler_WndProc = 1
  431. Else
  432.         FA_Handler_WndProc = 1
  433. End If
  434.  
  435. End Function
  436.  
  437. Private Function FA_DWM_Label_TrackMouse_Start()
  438.  
  439. Dim ET As TRACKMOUSEEVENT
  440. ET.hwndTrack = UserControl.hWnd
  441. ET.dwFlags = TrackMouseEventFlags.TME_LEAVE
  442. ET.cbSize = Len(ET)
  443. TRACKMOUSEEVENT ET
  444.  
  445. End Function
  446.  
  447. Private Function FA_DWM_Label_FreeDC_Src()
  448. CloseThemeData FA_DWM_Label_ThemeTextObj.hTheme
  449. SelectObject FA_DWM_Label_ThemeTextObj.hDC_Src, FA_DWM_Label_ThemeTextObj.BMP_Src_Old
  450. SelectObject FA_DWM_Label_ThemeTextObj.hDC_Src, FA_DWM_Label_ThemeTextObj.hFont_Old
  451. DeleteObject FA_DWM_Label_ThemeTextObj.BMP_Src
  452. DeleteObject FA_DWM_Label_ThemeTextObj.hFont
  453. ReleaseDC FA_DWM_Label_ThemeTextObj.hDC_Src, -1
  454. DeleteDC FA_DWM_Label_ThemeTextObj.hDC_Src
  455. End Function
  456.  
  457. Private Function FA_DWM_Label_FreeDC_Dest()
  458. SelectObject FA_DWM_Label_ThemeTextObj.hDC_Dest, FA_DWM_Label_ThemeTextObj.BMP_Dest_Old
  459. DeleteObject FA_DWM_Label_ThemeTextObj.BMP_Dest
  460. ReleaseDC FA_DWM_Label_ThemeTextObj.hDC_Dest, -1
  461. DeleteDC FA_DWM_Label_ThemeTextObj.hDC_Dest
  462. End Function
  463.  
  464.